home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / dev / lang / fpcsrc.lha / fpc / compiler / tgen68k.pas < prev    next >
Pascal/Delphi Source File  |  1998-09-24  |  21KB  |  685 lines
  1. {
  2.     $Id: tgen68k.pas,v 1.1.1.1.2.4 1998/07/21 12:11:37 carl Exp $
  3.     Copyright (c) 1993-98 by Florian Klaempfl, Carl Eric Codere
  4.  
  5.     This unit handles the temporary variables stuff for m68k
  6.  
  7.     This program is free software; you can redistribute it and/or modify
  8.     it under the terms of the GNU General Public License as published by
  9.     the Free Software Foundation; either version 2 of the License, or
  10.     (at your option) any later version.
  11.  
  12.     This program is distributed in the hope that it will be useful,
  13.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15.     GNU General Public License for more details.
  16.  
  17.     You should have received a copy of the GNU General Public License
  18.     along with this program; if not, write to the Free Software
  19.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20.  
  21.  ****************************************************************************
  22. }
  23. unit tgen68k;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        cobjects,globals,tree,hcodegen,verbose,files,aasm
  29. {$ifdef m68k}
  30.        ,m68k
  31. {$endif}
  32.        ;
  33.  
  34.     type
  35.        tregisterset = set of tregister;
  36.        tpushed = array[R_D0..R_A6] of boolean;
  37.  
  38.     const
  39.        { D2 to D5 usable as scratch registers }
  40.        usablereg32 : byte = 4;
  41.        { A2 to A4 usable as address registers }
  42.        usableaddress: byte = 3;
  43.        { FP2 to FP7 usable as FPU registers   }
  44.        usablefloatreg : byte = 6;
  45.  
  46.     function getregister32 : tregister;
  47.     procedure ungetregister32(r : tregister);
  48.     { return a free 32-bit address register }
  49.     function getaddressreg: tregister;
  50.  
  51.     procedure ungetregister(r : tregister);
  52.  
  53.     procedure cleartempgen;
  54.  
  55.     { generates temporary variables }
  56.     procedure resettempgen;
  57.     procedure setfirsttemp(l : longint);
  58.     function gettempsize : longint;
  59.     function gettempofsize(size : longint) : longint;
  60.     procedure gettempofsizereference(l : longint;var ref : treference);
  61.     function istemp(const ref : treference) : boolean;
  62.     procedure ungetiftemp(const ref : treference);
  63.     function getfloatreg: tregister;
  64.     { returns a free floating point register }
  65.     { used in real, fpu mode, otherwise we   }
  66.     { must use standard register allocation  }
  67.  
  68.     procedure del_reference(const ref : treference);
  69.     procedure del_locref(const location : tlocation);
  70.  
  71.  
  72.     { pushs and restores registers }
  73.     procedure pushusedregisters(var pushed : tpushed;b : word);
  74.     procedure popusedregisters(const pushed : tpushed);
  75.  
  76.     var
  77.        unused,usableregs : tregisterset;
  78.        c_usableregs : longint;
  79.  
  80.        usedinproc : word;
  81.  
  82.        { count, how much a register must be pushed if it is used as register }
  83.        { variable                                                            }
  84.        reg_pushes : array[R_D0..R_A6] of longint;
  85.        is_reg_var : array[R_D0..R_A6] of boolean;
  86.  
  87.   implementation
  88.  
  89.  
  90.     function getusableaddr: byte;
  91.     { Since address registers are different then data registers }
  92.     { we check the unused register list to determine the number }
  93.     { of address registers which are available.                 }
  94.     var
  95.       i: byte;
  96.     Begin
  97.       i:=0;
  98.       if R_A2 in unused then
  99.         Inc(i);
  100.       if R_A3 in unused then
  101.         Inc(i);
  102.       if R_A4 in unused then
  103.          Inc(i);
  104.       getusableaddr:=i;
  105.     end;
  106.  
  107.     procedure pushusedregisters(var pushed : tpushed;b : word);
  108.  
  109.       var
  110.          r : tregister;
  111.  
  112.       begin
  113.          { the following registers can be pushed }
  114.          { D0, D1, D2, D3, D4, D5, D6, D7, A0    }
  115.          { A1, A2, A3, A4                        }
  116.          for r:=R_D2 to R_A4 do
  117.            begin
  118.               pushed[r]:=false;
  119.               { if the register is used by the calling subroutine    }
  120.               if ((b and ($800 shr word(r)))<>0) then
  121.                 begin
  122.                    { and is present in use }
  123.                    if not(r in unused) then
  124.                      begin
  125.                         { then save it }
  126.                         { then save it on the stack }
  127.                         exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,r,R_SPPUSH)));
  128.                         { here was a big problem  !!!!!}
  129.                         { you cannot do that for a register that is
  130.                         globally assigned to a var
  131.                         this also means that you must push it much more
  132.                         often, but there must be a better way
  133.                         maybe by putting the value back to the stack !! }
  134.                         if not(is_reg_var[r]) then
  135.                           unused:=unused+[r];
  136.                         pushed[r]:=true;
  137.                      end;
  138.                 end;
  139.            end;
  140.       end;
  141.  
  142.     procedure popusedregisters(const pushed : tpushed);
  143.  
  144.       var
  145.          r : tregister;
  146.  
  147.       begin
  148.          for r:=R_A4 downto R_D2 do
  149.            if pushed[r] then
  150.              begin
  151.                 exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_SPPULL,r)));
  152.                 unused:=unused-[r];
  153.              end;
  154.       end;
  155.  
  156.     procedure ungetregister(r : tregister);
  157.  
  158.       begin
  159.            ungetregister32(r)
  160.       end;
  161.  
  162.  
  163.     procedure del_reference(const ref : treference);
  164.  
  165.       begin
  166.          if ref.isintvalue then
  167.            exit;
  168.          ungetregister(ref.base);
  169.          ungetregister32(ref.index);
  170.       end;
  171.  
  172.     procedure del_locref(const location : tlocation);
  173.  
  174.       begin
  175.          if (location.loc<>loc_mem) and (location.loc<>loc_reference) then
  176.            exit;
  177.          if location.reference.isintvalue then
  178.            exit;
  179.          ungetregister(location.reference.base);
  180.          ungetregister32(location.reference.index);
  181.       end;
  182.  
  183.     procedure ungetregister32(r : tregister);
  184.  
  185.       begin
  186.          if r in [R_D2,R_D3,R_D4,R_D5,R_D7] then
  187.           begin
  188.              unused:=unused+[r];
  189.              inc(usablereg32);
  190.           end
  191.          else
  192.          if r in [R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7] then
  193.          begin
  194.               unused:=unused+[r];
  195.               inc(usablefloatreg);
  196.          end
  197.          else
  198.          if r in [R_A2,R_A3,R_A4] then
  199.            begin
  200.               unused:=unused+[r];
  201.               inc(usableaddress);
  202.            end;
  203.         { other registers are RESERVED and should not be freed }
  204.       end;
  205.  
  206.  
  207.     function getfloatreg: tregister;
  208.     { returns a free floating point register }
  209.     { used in real, fpu mode, otherwise we   }
  210.     { must use standard register allocation  }
  211.     var
  212.      i:tregister;
  213.     begin
  214.       dec(usablefloatreg);
  215.       if usablefloatreg = 0 then
  216.        Message(cg_f_internal_error_in_getfloatreg);
  217.       for i:=R_FP2 to R_FP7 do
  218.       begin
  219.          if i in unused then
  220.          begin
  221.            unused := unused-[i];
  222.            getfloatreg := i;
  223.            exit;
  224.          end;
  225.       end;
  226.       { if we are here, then there was an allocation failure }
  227.       Message(cg_f_internal_error_in_getfloatreg);
  228.     end;
  229.  
  230.  
  231.     function getaddressreg: tregister;
  232.  
  233.      begin
  234.          dec(usableaddress);
  235.          if R_A2 in unused then
  236.            begin
  237.               unused:=unused-[R_A2];
  238.               usedinproc:=usedinproc or ($800 shr word(R_A2));
  239.               getaddressreg:=R_A2;
  240.            end
  241.          else
  242.          if R_A3 in unused then
  243.            begin
  244.               unused:=unused-[R_A3];
  245.               usedinproc:=usedinproc or ($800 shr word(R_A3));
  246.               getaddressreg:=R_A3;
  247.            end
  248.          else
  249.          if R_A4 in unused then
  250.            begin
  251.               unused:=unused-[R_A4];
  252.               usedinproc:=usedinproc or ($800 shr word(R_A4));
  253.               getaddressreg:=R_A4;
  254.            end
  255.          else
  256.          begin
  257.            internalerror(10);
  258.          end;
  259.  
  260.      end;
  261.  
  262.     function getregister32 : tregister;
  263.       begin
  264.          dec(usablereg32);
  265.          if R_D2 in unused then
  266.            begin
  267.               unused:=unused-[R_D2];
  268.               usedinproc:=usedinproc or ($800 shr word(R_D2));
  269.               getregister32:=R_D2;
  270.            end
  271.          else if R_D3 in unused then
  272.            begin
  273.               unused:=unused-[R_D3];
  274.               usedinproc:=usedinproc or ($800 shr wo